home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Toolbox classes / Event < prev    next >
Encoding:
Text File  |  1995-07-05  |  7.6 KB  |  310 lines  |  [TEXT/MSET]
  1. \ Event handling.
  2.  
  3. \ Nov 90 - Bob Loewenstein's improvements incorporated.
  4. \ Apr 91 - AppleEvents recognized.
  5. \ May 91 - Suspend and Resume events now deactivate/activate any Mops window
  6. \ June 92- Added PAUSE to WaitClick loop so we don't freeze in background
  7. \ July 92- Modified mouse-evt to leave wnd alone on non-window clicks
  8. \ 21Apr94 DBH
  9.      \ changed all event handlers so they do not return booleans
  10.      \ changed key: method in class event
  11.      \ redefined key-evt to contain all key related actions
  12.  
  13.  
  14.  
  15. \ MultiFinder/System 7 suspend and resume events are recognized.  To act on
  16. \ these events, set the vectors SuspendVec and ResumeVec to whatever words
  17. \ you want to execute.
  18.  
  19.  
  20. false    value    SUSPEND?    \ True if we've just received a Suspend event
  21. false    value    RESUME?        \ Ditto for Resume.  These two flags are set 
  22.                             \  appropriately by the OS event handler so other
  23.                             \  code can check if the event was Suspend or
  24.                             \  Resume, without having to re-perform the
  25.                             \  long-winded check.
  26.  
  27. dicaddr    MBADDR                \ Forward reference the menu bar
  28.  
  29. : DBLTICKS  $ 2f0  @  ;        \ Max ticks for double click
  30.  
  31. variable    THEDLG
  32. variable    THEPOINT
  33.  
  34. : G->L        \ ( gy:gx -- ly:lx )  Converts a global point to a local point.
  35.     thePoint !
  36.     thePoint  call GlobalToLocal
  37.     thePoint @  ;
  38.  
  39. : L->G        \ ( ly:lx -- gy:gx )
  40.     thePoint !
  41.     thePoint  call LocalToGlobal
  42.     thePoint @  ;
  43.  
  44. : (AEErr)        \ ( err# -- )  Default for error returns from AppleEvent
  45.                 \  handlers -- see AEErrorVec below.
  46.  
  47.     fWind? if .  2 spaces  then  161 die  ;    
  48.  
  49. ' null    vect    NEXT_TASK        \ If multitasking installed, this will be
  50.                                 \ redirected to do a task switch.
  51.  
  52. ' null    vect    SuspendVec        \ Called for suspend and resume
  53. ' null    vect    ResumeVec        \  events - redirect as necessary.
  54. ' null    vect    CvtClip            \ Called for clip conversion
  55. ' null    vect    MouseMoved        \ Called for mouse moved
  56.  
  57. ' vfalse    vect    HLEventVEC    \ Called for generic high-level events
  58. ' (AEerr)    vect    AEErrorVec    \ Called when an AppleEvent handler returns
  59.                                 \  an error
  60.                                 
  61.  
  62. :class  EVENT    super{ x-array }
  63.  
  64. record
  65. {    uint    WHAT
  66.     var        MSG
  67.     var        TIME
  68.     var        LOC
  69.     int        MODS
  70.     int        MASK
  71. }
  72.  
  73. :m TYPE:    get: what  ;m
  74. :m MODS:    get: mods  ;m
  75. :m SETMASK:    put: mask  ;m
  76. :m GETMASK:    get: mask  ;m
  77. :m MSG:        get: msg   ;m
  78.  
  79. :m WHERE:        \ ( -- mpoint )  Leaves mouse loc as global toolbox point
  80.     get: loc  ;m
  81.  
  82. :m MSGCLASS:    \ ( -- mclass )  Gets high-level message class.
  83.     get: msg  ;m
  84.  
  85. :m MSGID:        \ ( -- ID )  Gets high-level message ID.
  86.     get: loc  ;m
  87.  
  88. :m WHEN:        \ ( -- ticks )  Returns ticks.
  89.     get: time   ;m
  90.  
  91.  \ 21Apr94 DBH next: no longer returns a boolean
  92.  
  93. :m NEXT:    \   Gets the next event and executes its handler.
  94.     ^base  get: mask  nextEvent
  95.     IF  get: what  ELSE  0  THEN
  96.     exec: super  ;m
  97.  
  98. \ :m KEY:        \ ( -- c mods )  Handles events until a key event occurs.
  99. \    begin  next: self  until  ;m
  100.  
  101. :m KEY:        \ ( -- c )  Handles events until a key event occurs.  \ 08Jan94 XXX
  102.     BEGIN
  103. \        ^base  get: mask  nextEvent drop
  104.         next: self
  105.         get: what konst keyDown =
  106.     UNTIL
  107.     msg: self  $ FF and
  108.     ;m
  109.  
  110. ;class
  111.  
  112.  
  113. fEvent  ' event  set_class
  114.  
  115. 30  ' fEvent  w!        \ Offset to indexed elts - *** KLUDGE!!
  116.  
  117. :f  whrFEv    where: fEvent  ;f
  118.  
  119.  
  120. \ Define the mouse as an object:
  121.  
  122. :class  MOUSE    super{ object }
  123. record
  124. {    var    LAST        \ ticks when last click occurred
  125.     var    INTERVAL    \ ticks between clicks
  126. }
  127.  
  128. :m PUT:        \ ( ticks -- )
  129.             \ Updates the click interval with current system Ticks value
  130.     dup  get: last  -  put: interval  put: last  ;m
  131.  
  132. :m CLICK:    \ ( -- type )
  133.             \ Returns the type of click that last occurred: 2 = double
  134.     get: interval  dup  0>  swap  dblTicks <  and
  135.     IF  2  ELSE  1  THEN  ;m
  136.  
  137. :m WHERE:    \ Returns the mouse position as local Mops point
  138.     ?terminal drop  where: fEvent  g->l  unpack  ;m
  139.  
  140. :m GET:        \ ( -- x y dn? )
  141.             \ Return the current state of the mouse
  142.             \ - position and whether down
  143.     where: self  word0  call Button  word0  ;m
  144.  
  145. ;class
  146.  
  147.  
  148. mouse    THEMOUSE
  149.  
  150.  
  151. : WINDOWKIND        \ ( wnd-ptr -- n )
  152.     $ 6C +  w@  ;
  153.  
  154.  
  155. 0    value    WND        \ Addr of window we're looking at, or zero if none.
  156.                     \ We need to late-bind to it since the window object
  157.                     \  may be a sub-class.
  158.  
  159. : APPWIND?        \ ( -- b )  True if this is an application window.
  160.                 \ This check is necessary for non-multifinder systems
  161.                 \ while calling WaitNextEvent.
  162.  
  163.     wnd windowKind  8 =  ;
  164.  
  165.  
  166. : STILLDOWN?        \ Returns true if mouse button is still down.
  167.     word0  call StillDown  word0  ;
  168.  
  169.  
  170. : WAITCLICK        \ Waits until a mouse click or key event
  171.     BEGIN  pause  10 ?event  UNTIL  ;
  172.  
  173.  
  174. : DESK  ;        \ Desktop click handler - does nothing
  175.  
  176. : SYS        \ ( wind -- )  System  click handler
  177.     addr: fEvent  swap  call SystemClick  ;
  178.  
  179. : NULL-EVT    \ Note: now we're calling WaitNextEvent
  180.             \ instead of GetNextEvent, we shouldn't call SystemTask.
  181.     next_task
  182.     actW ?dup IF  idle: []  THEN  ;
  183.  
  184.  
  185. : (MOUSE-EVT)        \ ( rgn -- )
  186.     SELECT{
  187.         0 is{    desk                                }end
  188.         1 is{    get: MBaddr  click: []                }end
  189.         2 is{    wnd  sys                               }end
  190.         3 is{    appWind?  0EXIT  content: [ wnd ]      }end
  191.         4 is{    appWind?  0EXIT  drag: [ wnd ]        }end
  192.         5 is{    appWind?  0EXIT  grow: [ wnd ]        }end
  193.         6 is{    word0 wnd  where: fevent
  194.                 call trackGoAway  word0
  195.                 IF  close: [ wnd ]  THEN              }end
  196.         7 is{    7  zoom: [ wnd ]                    }end
  197.         8 is{    8  zoom: [ wnd ]                    }end
  198.         default{   abort
  199.     }SELECT  ;
  200.  
  201.  
  202. : MOUSE-EVT
  203.     when: fEvent  put: theMouse        \ update click interval
  204.     where: fEvent  find-window  -> wnd
  205.     (mouse-evt) ;
  206.  
  207.  
  208. : KEY-EVT
  209.  
  210.     mods: fEvent  $ 100 and                \ command key?
  211.     IF                                    \ Yes - check for menu selection
  212.         msg: fEvent  get: MBaddr  key: []
  213.         EXIT
  214.     THEN
  215.     0  call frontWindow  -> wnd  appWind?
  216.     NIF   EXIT  THEN                    \ Out if not our window.
  217.     actW
  218.     IF                                    \ Our window, so we send it a KEY: message:
  219.         msg: fEvent  $ FF and
  220.         key: [ actw ]
  221.     THEN ;
  222.  
  223.  
  224. : DISK-EVT        \  Handles a disk insert event.
  225.     watchcurs
  226.     msg: fEvent  0<
  227.     IF
  228.         call DILoad
  229.         word0  SFloc  msg: fEvent  call DIBadMount  word0 drop
  230.         call DIUnload
  231.     THEN
  232.     arrowcurs  ;
  233.  
  234.  
  235. : UPD-EVT        \ Causes window draw.
  236.     msg: fEvent  -> wnd
  237.     appWind? IF  draw: [ wnd ]  THEN   ;
  238.  
  239.  
  240. : ACTV-EVT        \ Activates a window.
  241.     msg: fEvent  -> wnd
  242.     appWind?
  243.     IF    mods: fEvent  01 and
  244.         IF        wnd -> actW  enable: [ wnd ]
  245.         ELSE    0 -> actW  disable: [ wnd ]
  246.         THEN
  247.     THEN ;
  248.  
  249.  
  250. : OS-EVT  { \ hiByte -- }        \ Operating system events.
  251.     false -> suspend?  false -> resume?
  252.     msg: fEvent  24 >>  -> hiByte
  253.     msg: fEvent  2 and  if  cvtClip  then
  254.     hiByte  $ FA and  if  mouseMoved  then
  255.     hiByte 1 =
  256.     IF         \ Suspend or Resume event
  257.         msg: fEvent  1 and
  258.         IF         \ Resume
  259.             saveActW -> actW
  260.             actW IF  enable: [ actW ]   THEN
  261.             true -> resume?   resumeVec
  262.         ELSE    \ Suspend
  263.             word0  call HiliteMenu
  264.             actW -> saveActW
  265.             actW IF  disable: [ actW ]   0 -> actW  THEN
  266.             true -> suspend?   suspendVec
  267.         THEN
  268.     THEN ;
  269.  
  270.  
  271. : HL-EVT        \ High-level events.
  272.     HLeventVec                        \ Maybe handle as generic HL event.  Done?
  273.     IF  EXIT  THEN                    \ Out if yes.  Otherwise...
  274.                                     \ ... (drum roll please) ...
  275.  
  276.             \ It's an AppleEvent!!  Now let's not panic, but just take
  277.             \ this step by step...
  278.  
  279.     word0  fEvent  call AEProcessAppleEvent  i->l
  280.  
  281.             \ Several things may have happened in the AppleEvent handler,
  282.             \ which we couldn't fully handle there.  We look for them in
  283.             \ priority order.  First, we quit the application if requested,
  284.             \ without worrying about error indications.
  285.  
  286.     quitApp? IF  quitAppVec  false -> quitApp?  THEN
  287.  
  288.             \ Now we take a Mops error if one was signalled by the handler.
  289.             \ We can't do this inside the handler since it's a :PROC.
  290.             \ Penalty: CRASH!
  291.  
  292.     (err#)  ?dup IF  die  THEN
  293.  
  294.             \ Finally, if a system error code was returned from the
  295.             \ handler, we execute AEErrorVec to do whatever is necessary.
  296.  
  297.     ?dup IF  AEErrorVec  THEN
  298.  
  299.             \ If we somehow got through to here, everything is OK!!
  300.     ;
  301.  
  302.  
  303. \ Here we set the default for KEY.
  304.  
  305. : (KEY)        \ ( -- c )
  306.     key: fEvent
  307.     ;
  308.  
  309. : (KEY!)    ['] (key)  -> key  ;
  310.